home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / connec1a / frmmain.frm (.txt) < prev    next >
Visual Basic Form  |  1999-09-09  |  7KB  |  191 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    Appearance      =   0  'Flat
  4.    AutoRedraw      =   -1  'True
  5.    BackColor       =   &H00000000&
  6.    BorderStyle     =   0  'None
  7.    Caption         =   "Connect IV"
  8.    ClientHeight    =   7965
  9.    ClientLeft      =   0
  10.    ClientTop       =   0
  11.    ClientWidth     =   10215
  12.    ControlBox      =   0   'False
  13.    FillStyle       =   0  'Solid
  14.    Icon            =   "frmMain.frx":0000
  15.    KeyPreview      =   -1  'True
  16.    LinkTopic       =   "Form1"
  17.    MaxButton       =   0   'False
  18.    MinButton       =   0   'False
  19.    ScaleHeight     =   7965
  20.    ScaleWidth      =   10215
  21.    ShowInTaskbar   =   0   'False
  22.    StartUpPosition =   2  'CenterScreen
  23. Attribute VB_Name = "frmMain"
  24. Attribute VB_GlobalNameSpace = False
  25. Attribute VB_Creatable = False
  26. Attribute VB_PredeclaredId = True
  27. Attribute VB_Exposed = False
  28. 'This is Connect IV written by Biffa Sniffa in August 1999
  29. 'The controls are as follows
  30. ' :Left Arrow to move left
  31. ' :Right Arrow to move right
  32. ' :Space to drop piece into current slot
  33. ' :R Key to Reset the Game
  34. ' :Esc Key to End the Game
  35. ' Enjoy!
  36. ' Mr Snif.
  37. Option Explicit
  38. Const BTOP = 100
  39. Const BLEFT = 100
  40. Const BHEIGHT = 7865
  41. Const BWIDTH = 10115
  42. Const XTRAWID = 715
  43. Const XTRAHGT = 655
  44. Const HGT = 7740
  45. Private Position(7, 6) As String
  46. Private LPosition(7, 3) As Integer
  47. Private GridPos(7, 6) As Integer
  48. Private CurrColumn As Integer
  49. Private PlayerNo As Integer
  50. ' form height is 7965
  51. ' form width is 10215
  52. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  53.     'MsgBox KeyCode
  54.     '37 is left
  55.     '39 is right
  56.     '32 is space
  57.     '27 is esc
  58.     '82 is R(Restart)
  59.                
  60.     Select Case KeyCode
  61.         Case 37 'Left key
  62.             If CurrColumn = 1 Then
  63.                 'do nothing
  64.             Else
  65.                 Call MovedColumn(CurrColumn - 1, CurrColumn)
  66.             End If
  67.         Case 39 'Right key
  68.             If CurrColumn = 7 Then
  69.                 'do nothing
  70.             Else
  71.                 Call MovedColumn(CurrColumn + 1, CurrColumn)
  72.             End If
  73.         Case 32 'Drop key
  74.             Call Drop(CurrColumn, PlayerNo)
  75.         Case 27 'ESC key
  76.             End
  77.         Case 82 'R key Restart
  78.             Call Reset
  79.     End Select
  80. End Sub
  81. Private Sub Form_Load()
  82.     Dim i As Integer
  83.     Dim j As Integer
  84.     Dim PosX As Integer
  85.     Dim posy As Integer
  86.     PlayerNo = 1
  87.     ' Draws the Blue Box using B for BOX and F for FILL
  88.     Me.Line (BTOP, BLEFT)-(BWIDTH, BHEIGHT), vbBlue, BF
  89.     ' Draw the circles for the pieces to fall into
  90.     For i = 1 To 7
  91.         For j = 1 To 6
  92.             PosX = (1450 * i) - XTRAWID
  93.             posy = (1330 * j) - XTRAHGT
  94.             Me.FillColor = vbBlack
  95.             Me.Circle (PosX, posy), 500, vbBlack
  96.             
  97.             'Sets an array with all positions
  98.             Position(i, j) = CStr(PosX) & ":" & CStr(posy)
  99.             If j = 1 Then
  100.                 LPosition(i, 0) = PosX - 550
  101.                 LPosition(i, 1) = posy - 550
  102.                 LPosition(i, 2) = PosX + 550
  103.             End If
  104.         Next j
  105.     Next i
  106.     Me.Line (LPosition(1, 0), LPosition(1, 1))-(LPosition(1, 2), LPosition(1, 1)), vbWhite
  107.     Me.Line (LPosition(1, 0), LPosition(1, 1))-(LPosition(1, 0), (LPosition(1, 1) + HGT)), vbWhite
  108.     Me.Line (LPosition(1, 2), LPosition(1, 1))-(LPosition(1, 2), (LPosition(1, 1) + HGT)), vbBlack
  109.     Me.Line (LPosition(1, 0), LPosition(1, 1) + HGT)-(LPosition(1, 2), LPosition(1, 1) + HGT), vbBlack
  110.     CurrColumn = 1
  111. End Sub
  112. Private Sub MovedColumn(NewCol As Integer, CurrCol As Integer)
  113.     Dim i As Integer
  114.     i = NewCol
  115.     Me.Line (LPosition(i, 0), LPosition(i, 1))-(LPosition(i, 2), LPosition(i, 1)), vbWhite
  116.     Me.Line (LPosition(i, 0), LPosition(i, 1))-(LPosition(i, 0), (LPosition(i, 1) + HGT)), vbWhite
  117.     Me.Line (LPosition(i, 2), LPosition(i, 1))-(LPosition(i, 2), (LPosition(i, 1) + HGT)), vbBlack
  118.     Me.Line (LPosition(i, 0), LPosition(i, 1) + HGT)-(LPosition(i, 2), LPosition(i, 1) + HGT), vbBlack
  119.     i = CurrCol
  120.     Me.Line (LPosition(i, 0), LPosition(i, 1))-(LPosition(i, 2), LPosition(i, 1)), vbBlue
  121.     Me.Line (LPosition(i, 0), LPosition(i, 1))-(LPosition(i, 0), (LPosition(i, 1) + HGT)), vbBlue
  122.     Me.Line (LPosition(i, 2), LPosition(i, 1))-(LPosition(i, 2), (LPosition(i, 1) + HGT)), vbBlue
  123.     Me.Line (LPosition(i, 0), LPosition(i, 1) + HGT)-(LPosition(i, 2), LPosition(i, 1) + HGT), vbBlue
  124.     CurrColumn = NewCol
  125. End Sub
  126. Private Sub Drop(CurrCol As Integer, Player As Integer)
  127.     Dim i As Integer
  128.     Dim j As Integer
  129.     Dim colpos As Integer
  130.     Dim CurX As Integer
  131.     Dim CurY As Integer
  132.     i = CurrCol
  133.     For j = 6 To 1 Step -1
  134.         If GridPos(i, j) = 0 Then
  135.             GridPos(i, j) = Player
  136.             colpos = InStr(Position(i, j), ":")
  137.             CurX = Left(Position(i, j), colpos - 1)
  138.             CurY = Mid(Position(i, j), colpos + 1, Len(Position(i, j)))
  139.             Select Case Player
  140.                 Case 1
  141.                     Me.FillColor = vbYellow
  142.                     Me.Circle (CurX, CurY), 475, vbYellow
  143.                 Case 2
  144.                     Me.FillColor = vbRed
  145.                     Me.Circle (CurX, CurY), 475, vbRed
  146.             End Select
  147.             Exit For
  148.         End If
  149.     Next j
  150.     If PlayerNo = 1 Then
  151.         PlayerNo = 2
  152.     Else
  153.         PlayerNo = 1
  154.     End If
  155.        
  156. End Sub
  157. Private Sub Reset()
  158.     Dim i As Integer
  159.     Dim j As Integer
  160.     Dim PosX As Integer
  161.     Dim posy As Integer
  162.     For i = 1 To 7
  163.         For j = 1 To 6
  164.             GridPos(i, j) = 0
  165.         Next j
  166.     Next i
  167.     PlayerNo = 1
  168.     Call MovedColumn(1, CurrColumn)
  169.     For i = 1 To 7
  170.         For j = 1 To 6
  171.             PosX = (1450 * i) - XTRAWID
  172.             posy = (1330 * j) - XTRAHGT
  173.             Me.FillColor = vbBlack
  174.             Me.Circle (PosX, posy), 500, vbBlack
  175.             
  176.             'Sets an array with all positions
  177.             Position(i, j) = CStr(PosX) & ":" & CStr(posy)
  178.             If j = 1 Then
  179.                 LPosition(i, 0) = PosX - 550
  180.                 LPosition(i, 1) = posy - 550
  181.                 LPosition(i, 2) = PosX + 550
  182.             End If
  183.         Next j
  184.     Next i
  185.     Me.Line (LPosition(1, 0), LPosition(1, 1))-(LPosition(1, 2), LPosition(1, 1)), vbWhite
  186.     Me.Line (LPosition(1, 0), LPosition(1, 1))-(LPosition(1, 0), (LPosition(1, 1) + HGT)), vbWhite
  187.     Me.Line (LPosition(1, 2), LPosition(1, 1))-(LPosition(1, 2), (LPosition(1, 1) + HGT)), vbBlack
  188.     Me.Line (LPosition(1, 0), LPosition(1, 1) + HGT)-(LPosition(1, 2), LPosition(1, 1) + HGT), vbBlack
  189.     CurrColumn = 1
  190. End Sub
  191.